Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/SIMPDB.PAS

Pascal/Delphi Source File | 1997-03-02 | 5KB | 192 lines

UNIT SimpDB;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Simple database object with automatic reuse   Last changed: 02.03.97  SA ║}
{║ of deleted records                                                       ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-97 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, Dos,
     PoPTypes, NetFile;

TYPE
  PFirstRec = ^TFirstRec;
  TFirstRec = RECORD
    FirstDel : LongInt;   { Pointer to first deleted record or -1 if no       }
                          { deleted records exist.                            }
    RecSize  : Word;      { Record size - to reindex program and Open check.  }
  END;

  PSimpDB = ^TSimpDB;
  TSimpDB = OBJECT(TNetFile)
    CONSTRUCTOR Open(CONST AFName: PathStr; ARecSize: Word; Create: Boolean);
    DESTRUCTOR  Close; VIRTUAL;
    PROCEDURE AddRec(VAR Buffer); VIRTUAL;
    PROCEDURE DelRec(VAR Buffer; RecNum: LongInt);
    FUNCTION  NextRec(VAR Buffer; K: Boolean): Boolean;
    FUNCTION  PrevRec(VAR Buffer; K: Boolean): Boolean;
  PRIVATE
    FirstRec : PFirstRec;

    PROCEDURE GetFirstRec(K: Boolean);
    PROCEDURE PutFirstRec;
  END;

  PTitFile = ^TTitFile;
  TTitFile = OBJECT(TSimpDB)
    CONSTRUCTOR Open(Create: Boolean);
    PROCEDURE AddRec(VAR Buffer); VIRTUAL;

    FUNCTION  FindFile(AFName: S12; VAR TitRec: TInboundFile): Boolean;
    PROCEDURE RemoveFile(AFName: S12);
  END;


IMPLEMENTATION

USES OpString,
     Globals, LogFile, Util;

  CONSTRUCTOR TSimpDB.Open(CONST AFName: PathStr; ARecSize: Word; Create: Boolean);
  BEGIN
    IF ARecSize<SizeOf(TFirstRec) THEN ARecSize:=SizeOf(TFirstRec);
    IF NOT INHERITED Open(AFName, ARecSize, Create) THEN Fail;
    GetMem(FirstRec, RecSize);
    FillChar(FirstRec^, RecSize, 0);
    FirstRec^.FirstDel:=-1;
    FirstRec^.RecSize:=RecSize;
    GetFirstRec(NoKeep);
    IF RecSize<>FirstRec^.RecSize THEN
    BEGIN
      AddLog('!','Record size error in: '+FName);
      Close;
      Fail;
    END;
  END;

  DESTRUCTOR TSimpDB.Close;
  BEGIN
    FreeMem(FirstRec, FirstRec^.RecSize);
    INHERITED Close;
  END;

  PROCEDURE TSimpDB.AddRec(VAR Buffer);
  VAR
    RecNum : LongInt;
    TmpBuf : Pointer;
  BEGIN
    GetFirstRec(Keep);
    IF FirstRec^.FirstDel<>-1 THEN
    BEGIN
      GetMem(TmpBuf, FirstRec^.RecSize);
      RecNum:=FirstRec^.FirstDel;
      GetRec(TmpBuf^, RecNum, Keep, Wait);
      FirstRec^.FirstDel:=LongInt(TmpBuf^);
      FreeMem(TmpBuf, FirstRec^.RecSize);
      PutFirstRec;
    END ELSE
    BEGIN
      RecNum:=FileSize;
      Unlock(0);
    END;
    LongInt(Buffer):=0;
    PutRec(Buffer,RecNum);
  END;

  PROCEDURE TSimpDB.DelRec(VAR Buffer; RecNum: LongInt);
  BEGIN
    GetFirstRec(Keep);
    IF LongInt(Buffer)=0 THEN
    BEGIN
      LongInt(Buffer):=FirstRec^.FirstDel;
      FirstRec^.FirstDel:=RecNum;
      PutRec(Buffer, RecNum);
    END ELSE
      Unlock(RecNum);
    PutFirstRec;
  END;

  FUNCTION TSimpDB.NextRec(VAR Buffer; K: Boolean): Boolean;
  BEGIN
    LongInt(Buffer):=1;
    IF FilePos=0 THEN Seek(1);
    WHILE (LongInt(Buffer)<>0) AND NOT EoF DO
    BEGIN
      Read(Buffer, K, Wait);
      IF (LongInt(Buffer)<>0) AND K THEN Unlock(FilePos-1);
    END;
    NextRec:=(LongInt(Buffer)=0);
  END;

  FUNCTION TSimpDB.PrevRec(VAR Buffer; K: Boolean): Boolean;
  BEGIN
    PrevRec:=False;
{???
    LongInt(Buffer):=1;
    WHILE LongInt(Buffer)<>0 AND FilePos(f)>0 DO
    BEGIN
      NetRead(f, Buffer, K, Wait);
    END;
    PrevRec:=(LongInt(Buffer)=0);
}
  END;

  PROCEDURE TSimpDB.GetFirstRec(K: Boolean);
  BEGIN
    IF FileSize=0 THEN PutFirstRec;
    GetRec(FirstRec^, 0, K, True);
  END;

  PROCEDURE TSimpDB.PutFirstRec;
  BEGIN
    PutRec(FirstRec^, 0);
  END;

{=== TTitFile ===}

  CONSTRUCTOR TTitFile.Open(Create: Boolean);
  BEGIN
    IF NOT INHERITED Open(StartPath+PoPReceivedFiles, SizeOf(TInboundFile), Create) THEN Fail;
  END;

  PROCEDURE TTitFile.AddRec(VAR Buffer);
  BEGIN
    TInboundFile(Buffer).FileName:=StUpCase(TInboundFile(Buffer).FileName);
    INHERITED AddRec(Buffer);
  END;

  FUNCTION TTitFile.FindFile(AFName: S12; VAR TitRec: TInboundFile): Boolean;
  VAR
    Found  : Boolean;
  BEGIN
    AFName:=StUpCase(JustName(AFName));
    Found:=False;
    Seek(1);
    WHILE NOT Found AND NextRec(TitRec, Keep) DO
      IF TitRec.FileName=AFName THEN Found:=True ELSE Unlock(FilePos-1);
    IF Found THEN DelRec(TitRec, FilePos-1);
    FindFile:=Found;
  END;

  PROCEDURE TTitFile.RemoveFile(AFName: S12);
  VAR
    Found  : Boolean;
    TitRec : TInboundFile;
  BEGIN
    AFName:=StUpCase(JustName(AFName));
    Found:=False;
    Seek(1);
    WHILE NOT Found AND NextRec(TitRec, Keep) DO
      IF TitRec.FileName=AFName THEN Found:=True ELSE Unlock(FilePos-1);
    IF Found THEN DelRec(TitRec, FilePos-1);
  END;

END.